PD ROM 1/PD ROM Volume I - Macintosh Software from BMUG (1988).iso/Programming/Programming Tools/XCMDs/PanasonicTQ2024F.p

Text File | 1987-08-17 | 8.3 KB | 329 lines | [TEXT/ttxt]

{$R-}
{$D+}
(*
    PanasonicTQ2024F -- a HyperCard user-defined command to drive a
    Panasonic TQ-2024F write-once laserdisc player.
    ©Apple Computer, Inc. 1987
    All Rights Reserved.


    To compile and link this file using Macintosh Programmer's Workshop
    (HyperXCmd.p and XCmdGlue.inc must be accessible).

    pascal -w PanasonicTQ2024F.p
    link -m ENTRYPOINT -o HyperCommands -rt XCMD=11 -sn Main=PanasonicTQ2024F ∂
      PanasonicTQ2024F.p.o "{MPW}"Libraries:interface.o

    then use ResEdit to copy the resulting XCMD from HyperCommands
    and paste it into the Home stack, or your own stack.
    (XCMD=11 Panasonic, =12 Hitachi, =13 Phillips, =14 PioneerLDV6000)
*)

{$S PanasonicTQ2024F }     { Segment name must be the same as the command name. }

UNIT DummyUnit;

INTERFACE

   USES MemTypes, QuickDraw, OsIntf, HyperXCmd;

PROCEDURE EntryPoint(paramPtr: XCmdPtr);

IMPLEMENTATION

TYPE Str19 = String[19];
     Str31 = String[31];

PROCEDURE PanasonicTQ2024F(paramPtr: XCmdPtr);                        FORWARD;

   PROCEDURE EntryPoint(paramPtr: XCmdPtr);
   { entry point cannot have local procs, but forward routines can }
   BEGIN
     PanasonicTQ2024F(paramPtr);
   END;

   PROCEDURE PanasonicTQ2024F(paramPtr: XCmdPtr);
   VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
       tempStr: Str255;
       refNum: INTEGER;
       err: INTEGER;
       params: ARRAY[1..32] OF Str19;

     {$I XCmdGlue.inc }

     PROCEDURE Fail(errMsg: Str255); { set theResult and quit }
     BEGIN
       paramPtr^.returnValue := PasToZero(errMsg);
       EXIT(PanasonicTQ2024F);
     END;

     PROCEDURE OpenSerial;
     VAR handShake: SerShk;
         baudRate: INTEGER;
     BEGIN
       baudRate := 9600;
       { for now, use modem port so we don't mess with AppleTalk }
       err := FSOpen('.AOUT',0,refNum);
       IF err = 0 THEN
         BEGIN
           WITH handShake DO
             BEGIN
               fXon := 1;
               fCTS := 1;
               xon  := CHR(17);
               xoff := CHR(19);
               errs := 0;
               evts := 0;
               fInx := 0;
             END;
           err := SerHShake(refNum,handShake);
           IF err = 0 THEN
             err := Control(refNum,13,@baudRate);
         END;
     END;


     PROCEDURE CloseSerial;
     BEGIN
       err := FSClose(refNum);
     END;


     PROCEDURE SendCommand(cmd: Str255);
     VAR count: LongInt;
     BEGIN
       count := Length(cmd) + 2;
       cmd[Length(cmd) + 1] := CHR(3);    { control-c }
       cmd[0] := CHR(2);                     { control-B }
       { Is overwriting the length byte a dangerous thing? }
       err := FSWrite(refNum, count, @cmd);
     END;

     FUNCTION Concat(str1, str2, str3: Str255): Str255;
     VAR result: Str255;
         resultLen: INTEGER;
         charNum: INTEGER;
     BEGIN
       result := '';
       resultLen := 0;
       FOR charNum := 1 TO Length(str1) DO
         BEGIN
           resultLen := resultLen + 1;
           result[resultLen] := str1[charNum];
         END;
       FOR charNum := 1 TO Length(str2) DO
         BEGIN
           resultLen := resultLen + 1;
           result[resultLen] := str2[charNum];
         END;
       FOR charNum := 1 TO Length(str3) DO
         BEGIN
           resultLen := resultLen + 1;
           result[resultLen] := str3[charNum];
         END;
      result[0] := CHR(resultLen);
      Concat := result;
     END;


     PROCEDURE GetMessage;
     VAR paramNum, charNum: INTEGER;
         msgChar: CHAR;
     BEGIN
       { convert params to pascal strings }
       FOR paramNum := 1 TO paramPtr^.paramCount DO
         BEGIN
           tempStr := params[paramNum];
           ZeroToPas(paramPtr^.params[paramNum]^, tempStr);
           { force all chars to lower case }
           FOR charNum := 1 TO Length(tempStr) DO
             BEGIN
               msgChar := tempStr[charNum];
               IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
                 tempStr[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')));
             END;
           params[paramNum] := tempStr;
         END;
     END;


     FUNCTION Contains(target: Str255): BOOLEAN;
     VAR offset: INTEGER;

       FUNCTION Match(which: INTEGER): BOOLEAN;
       VAR index: INTEGER;
       BEGIN
         Match := TRUE;
         FOR index := 1 TO Length(target) DO
           IF index > Length(params[which]) THEN
             BEGIN
               Match := FALSE;  { ran off the end }
               EXIT(Match);
             END
           ELSE IF target[index] <> params[which][index] THEN
             BEGIN
               Match := FALSE;  { hit a wrong char }
               EXIT(Match);
             END;
       END;

     BEGIN
       Contains := FALSE;
       FOR offset := 1 TO paramPtr^.paramCount DO
         IF Match(offset) THEN
           BEGIN
             Contains := TRUE;
             EXIT(Contains);
           END;
     END;


     FUNCTION GetInteger: Str255;
     { get an integer in Pioneer format }
     VAR which, digitLoc, charVal: INTEGER;
     BEGIN
       FOR which := 1 TO paramPtr^.paramCount DO
         BEGIN
           charVal := ORD(params[which][1]);
           IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
             BEGIN
               GetInteger := params[which];        {that whole parameter}
                 exit(GetInteger);
             END;
         END;
       GetInteger := '';    { just in case }
     END;

   BEGIN
     OpenSerial;
     IF err <> 0 THEN
       BEGIN
         SysBeep(1);
         Fail('Could not open serial port');
       END;

     GetMessage;

     { set flags }
     reverseFlag := Contains('rev');
     offFlag := Contains('off');
     tillFlag := Contains('till');

     IF Contains('init') THEN SendCommand('AC;ON0:')
     ELSE IF Contains('stop') THEN SendCommand('TF')
     ELSE IF Contains('eject') THEN SendCommand('EJ')
     ELSE IF Contains('search') THEN SendCommand(Concat('SR', GetInteger, ':'))
     ELSE IF Contains('step') THEN
       BEGIN
         IF NOT reverseFlag THEN SendCommand('TF')        {step fwd}
         ELSE SendCommand('TR')                            {step rev}
       END
     ELSE IF Contains('play') THEN
       BEGIN
         IF NOT tillFlag THEN
             BEGIN
                IF NOT reverseFlag THEN SendCommand('PF')    {play fwd}
                 ELSE SendCommand('PR');                     {play rev}
            END
         ELSE
           BEGIN
                IF NOT reverseFlag
                THEN SendCommand(Concat('PF', GetInteger, ':'))     {play till fwd}
                 ELSE SendCommand(Concat('PR', GetInteger, ':')); {play till rev}
           END;
       END
     ELSE IF Contains('slower') THEN
       BEGIN
         IF tillFlag THEN
           BEGIN
             IF reverseFlag THEN SendCommand(Concat('LR32:', GetInteger, ':'))
             ELSE SendCommand(Concat('LF32:', GetInteger, ':'));
           END
         ELSE IF reverseFlag THEN SendCommand('LR32:')
           ELSE SendCommand('LF32:')
       END
     ELSE IF Contains('slowest') THEN
       BEGIN
         IF tillFlag THEN
           BEGIN
             IF reverseFlag THEN SendCommand(Concat('LR64:', GetInteger, ':'))
             ELSE SendCommand(Concat('LF64:', GetInteger, ':'));
           END
         ELSE IF reverseFlag THEN SendCommand('LR64:')
           ELSE SendCommand('LF64:')
       END
     ELSE IF Contains('slow') THEN
      IF NOT tillFlag THEN
        BEGIN
          IF NOT reverseFlag THEN SendCommand('LF16:')        {slow fwd}
          ELSE SendCommand('LR16:')                            {slow rev}
        END
      ELSE
        BEGIN
          IF NOT reverseFlag THEN SendCommand(Concat('LF16:', GetInteger, ':'))    {slow TILL fwd}
          ELSE SendCommand(Concat('LR16:', GetInteger, ':'))                {slow TILL rev}
        END
     ELSE IF Contains('faster') THEN
       BEGIN
         IF tillFlag THEN
           BEGIN
             IF reverseFlag THEN SendCommand(Concat('FR8:', GetInteger, ':'))
             ELSE SendCommand(Concat('FF8:', GetInteger, ':'));
           END
         ELSE IF reverseFlag THEN SendCommand('FR8:')
           ELSE SendCommand('FF8:')
       END
     ELSE IF Contains('fast') THEN
      IF NOT tillFlag THEN
        BEGIN
          IF NOT reverseFlag THEN SendCommand('FF3:')        {fast fwd}
          ELSE SendCommand('FR3:')                            {fast rev}
        END
      ELSE
        BEGIN
          IF NOT reverseFlag THEN SendCommand(Concat('FF3:', GetInteger, ':'))    {fast TILL fwd}
          ELSE SendCommand(Concat('FR3:', GetInteger, ':'))                {fast TILL rev}
        END
     ELSE IF Contains('scan') THEN
       BEGIN
         IF NOT reverseFlag THEN SendCommand('FF10:')            {scan fwd}
         ELSE SendCommand('FR10:')                                {scan rev}
       END
     ELSE IF Contains('picture') THEN
       BEGIN
         IF NOT offFlag THEN SendCommand('VS')                {picture on}
         ELSE SendCommand('VR')                                {picture off}
       END
     ELSE IF Contains('frame') THEN
       BEGIN
         IF NOT offFlag THEN SendCommand('DS')                {frame on}
         ELSE SendCommand('DR')                                {frame off}
       END
     ELSE IF Contains('sound') THEN
       BEGIN
         IF Contains('1') THEN
           IF NOT offFlag THEN SendCommand('A134:')            {sound 1 on}
           ELSE SendCommand('A10:')                            {sound 1 off}
         ELSE IF Contains('2') THEN
           IF NOT offFlag THEN SendCommand('A234:')            {sound 2 on}
           ELSE SendCommand('A20:')                            {sound 2 off}
         ELSE
           BEGIN
             CloseSerial;
             Fail('Unknown video sound channel');
           END;
       END
     ELSE
         BEGIN
          CloseSerial;
          SysBeep(1);
          Fail('Unknown video command');
        END;
     CloseSerial;
   END;

END.